home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.17 / pcq-programme / ufo / ufo2.p < prev    next >
Text File  |  1995-04-22  |  36KB  |  1,081 lines
  1.  
  2.  
  3. Program UFO;
  4.  
  5. {$I "Include:Utils/Stringlib.i"}
  6. {$I "Include:Utils/random.i"}
  7. {$I "Include:Intuition/Intuition.i"}
  8. {$I "include:Intuition/screens.i"  }
  9. {$I "include:graphics/Pens.i"      }
  10. {$I "include:graphics/Text.i"      }
  11. {$I "include:graphics/Graphics.i"  }
  12. {$I "include:Exec/libraries.i"  }
  13. {$I "include:game.i"}                 { * Die Spiel-Routinen * }
  14. {$I "prg/ufo/bilder"}                 { * Die Imagedaten     * }
  15.  
  16.  
  17. CONST
  18.  
  19.         { Wir definieren einen Screen mit 3-Bitlanes und keiner Titel-
  20.           leiste, Hires und 640 x 200 Punkte Auflösung }
  21.  
  22.         NewScr : NewScreen  =  ( 0, 0, 640, 200, 3, 1, 0, HIRES + SPRITES,
  23.                                  CUSTOMSCREEN_f + SCREENQUIET_f,
  24.                                  NIL, NIL, NIL, NIL);
  25.  
  26.         { Und jetzt ein Rahmenloses Fenster }
  27.  
  28.         NewWin : NewWindow  =  (0,0,640,200,0,0,0,
  29.                                 BORDERLESS + ACTIVATE,
  30.                                 NIL,NIL,"",
  31.                                 NIL,NIL,0,0,0,0,
  32.                                 CUSTOMSCREEN_F);
  33.  
  34. type
  35.     { * Die Definition für die Highscore-Liste. * }
  36.     spielerdef  = record
  37.                   name   : array [1..21] of char;
  38.                   punkte : integer;
  39.                   lev    : integer; { * Enthält den erreichten Level. * }
  40.     end;
  41.  
  42.     { * Die Definition der Level. * }
  43.     Leveldef    = record
  44.                   Objekte       : byte; { * Anzahl der Objekte. * }
  45.                   Fallen        : byte; { * Wieviele Fallen gibt es
  46.                                             zusätzlich ? * }
  47.                   Fallenspeed   : byte; { * Max. Speed der Fallen. * }
  48.                   Spielspeed    : short; { * Verzögerung für den VBServer. * }
  49.                   Anmerkung     : String; { * Falls wir noch was sagen
  50.                                               wollen. * }
  51.     end;
  52.  
  53. Const
  54.  
  55.     { * Und jetzt unsere 10 Level. * }
  56.     MaxLevel : byte =  10;
  57.  
  58.     Levels  : array[1..MaxLevel] of Leveldef =
  59. (
  60.     (   50,  2, 1,  3, "Easy is the first way!"),
  61.     (   50,  4, 1,  3, "Look out at the Death!"),
  62.     (   40,  8, 2,  3, "A few more Death !    "),
  63.     (   30,  8, 3,  2, "Yeah, not enough Objekts!"),
  64.     (   30, 10, 4,  2, "They will run on you! "),   { * 5. Level. * }
  65.     (   20, 10, 4,  2, ""),
  66.     (   20, 15, 6,  1, ""),
  67.     (   20, 20, 6,  1, "The Death is around you!"),
  68.     (   15, 25, 8,  0, ""),
  69.     (   15, 30, 8,  0, "If you stand, you win!")
  70. );
  71.  
  72.  
  73. VAR
  74.     Spieler : array [1..10] of spielerdef; { * Maximal 10 Einträge in der
  75.                                                Highscore-Liste. * }
  76.  
  77.     mainflag,loop : boolean; { Hauptsteuerung, Spielsteuerung }
  78.  
  79.         Irspunkte,
  80.         Irstank         : short;    { * Punkte- und Tankzähler * }
  81.         MaxObjekts      : byte;     { * Wieviele Objekte sollen auf
  82.                                         den Bildschirm? * }
  83.         Key             : byte;     { * Enthält den aktuellen Tastencode. * }
  84.         Level           : integer;  { * Enthält den aktuellen Level. * }
  85.  
  86. { ********************************************************************* }
  87.         MyVPort         : Address;
  88.         Scr             : ScreenPtr;
  89.         Win             : WindowPtr;
  90.  
  91. { ********************************************************************* }
  92. { Irgendwie wollen wir PCQ ja nun mal verlassen, oder? }
  93.  
  94. PROCEDURE Cleanexit(why : String ; rtcode : Integer);
  95. VAR
  96.     tt  : byte;
  97.     tt2 : short;
  98. BEGIN
  99.         for tt := 1 to 100 do begin
  100.             if Picture[tt] <> NIL then begin
  101.                 tt2 := (Picture[tt]^.Width + 15)/16; { wieviele Words? }
  102.                 tt2 := tt2 * Picture[tt]^.Height; { mal Höhe }
  103.                 tt2 := tt2 * Picture[tt]^.Depth; { mal BitPlanes }
  104.                 FreeRaster(Picture[tt]^.Imagedata,16,tt2);
  105.             end;
  106.         end;
  107.         if BlittiSpeicher <> Nil then FreeRaster(BlittiSpeicher,80,200);
  108.         if Win      <> NIL then CloseWindow(Win);
  109.         IF Scr      <> NIL THEN CloseScreen(Scr);
  110.         IF GfxBase  <> NIL THEN CloseLibrary(GfxBase);
  111.         ExitVB();   { * VBServer wieder abschalten. * }
  112.         For tt := 1 to 10 do FreeSample(tt);  { * Samples freigeben. * }
  113.  
  114.                 { ## Ausgabe ins CLI, warum das Program verlassen }
  115.                 { ## werden mußte, inkl.Returncode f. Batchfiles  }
  116.         IF why<>NIL THEN writeln(why);
  117.         Delay(100);
  118.         exit(rtcode);
  119. END;
  120.  
  121. { ********************************************************************* }
  122. { Ist für die Eintragung des Highscore Namens. }
  123.  
  124. Procedure GetString(xpos, ypos : short; an : byte; str : string);
  125. {* Liest in string str an Zeichen von der Position xpos, ypos. * }
  126.  
  127. var
  128.     g   : GadgetPtr;
  129.     gi  : StringInfoPtr;
  130.     tt  : boolean;
  131.     tt1 : short;
  132.     Msg : IntuiMessagePtr;
  133.     MsgClass    : integer;
  134.     MsgCode     : short;
  135.  
  136. BEGIN
  137.     str[0] := '\0';     { * Muß gesetzt werden, sonst klappts nicht ! * }
  138.  
  139.     { * Erst mal alles für das Gadget allokieren. * }
  140.  
  141.     New(gi);                            { * StringInfo allokieren. * }
  142.     gi^.Buffer     :=str;               { * Initialisieren. * }
  143.     gi^.UndoBuffer :=NIL;               { * Gibt keinen. * }
  144.     gi^.BufferPos  :=0;
  145.     gi^.MaxChars   :=an + 1;
  146.     gi^.DispPos    :=0;
  147.     gi^.AltKeyMap  :=NIL;
  148.  
  149.     New(g);                       { jetzt die Stringgadgets }
  150.     g^.NextGadget := NIL;
  151.     g^.LeftEdge   := xpos;
  152.     g^.TopEdge    := ypos;
  153.     g^.Width      := short(an * 8);
  154.     g^.Height     := 10;
  155.     g^.Flags      :=gadgHComp;    { auch ausfüllen }
  156.     g^.Activation :=relVerify;
  157.     g^.GadgetType :=strGadget;
  158.     g^.GadgetRender  :=NIL;
  159.     g^.SelectRender  :=NIL;
  160.     g^.GadgetText    :=NIL;
  161.     g^.MutualExclude :=0;
  162.     g^.SpecialInfo   :=gi;
  163.     g^.GadgetID      :=0;
  164.  
  165.     { * Noch ein Unterstrich * }
  166.  
  167.     Move(MyRPort,xpos,ypos+8);
  168.     Draw(MyRPort,xpos + (an * 8), ypos+8);
  169.  
  170.     { * Jetzt das zugehörige Window aktualisieren. * }
  171.  
  172.     ModifyIDCMP(Win, GADGETUP_f); { * Gadgetaktivitäten zulassen. * }
  173.  
  174.     { * Gadget anmachen und zeichen holen. * }
  175.  
  176.     tt1 := AddGadget(win,g,-1);
  177.     Refreshgadgets(g, win, Nil);
  178.     tt := ActivateGadget(g,win,NIL);
  179.  
  180.     Msg := IntuiMessagePtr(WaitPort(Win^.UserPort));
  181.     Msg := IntuiMessagePtr(GetMsg(Win^.UserPort));
  182.     IF Msg <> NIL then begin
  183.        MsgClass := Msg^.Class;
  184.        MsgCode  := Msg^.Code;
  185.        ReplyMsg(MessagePtr(Msg));
  186.     end;
  187.  
  188.     { * Und jetzt alles wieder zurückgeben. * }
  189.  
  190.     ModifyIDCMP(win,0);
  191.     SetRast(MyRPort,0);
  192.     gi^.Buffer := Nil;
  193.     tt1 := RemoveGadget(win,g);
  194.  
  195. end; {GetString}
  196.  
  197. {/***********************************************************************/}
  198. procedure SetColour(tt1,tt2 : byte); { tt1 = Vordergrundfarbe,tt2 = Hinter-
  199.                                      grundfarbe }
  200. begin
  201.     SetDrMd(MyRPort,JAM2);
  202.     SetAPen(MyRPort,tt1);
  203.     SetBPen(MyRPort,tt2);
  204. end; {SetColour}
  205.  
  206.  
  207. {/***********************************************************************/}
  208.  
  209. procedure init();      {/* Initialisiert alle Daten */}
  210.  
  211. var
  212.     tt1 : short;
  213. begin
  214.     If (LoadSample(1,"8svx/Damage.8SVX")) < 0 then
  215.        Cleanexit("Sample Nr.1 konnte nicht geladen werden!",10);
  216.     If (LoadSample(2,"8svx/Bam.instr")) < 0 then
  217.        Cleanexit("Sample Nr.2 konnte nicht geladen werden!",10);
  218.     If (LoadSample(3,"8svx/Ding2.Instr")) < 0 then
  219.        Cleanexit("Sample Nr.3 konnte nicht geladen werden!",10);
  220.     If (LoadSample(4,"8svx/entdeath.8SVX")) < 0 then
  221.        Cleanexit("Sample Nr.4 konnte nicht geladen werden!",10);
  222.     If (LoadSample(5,"8svx/Choice.instr")) < 0 then
  223.        Cleanexit("Sample Nr.5 konnte nicht geladen werden!",10);
  224.     If (LoadSample(6,"8svx/klinfire.8SVX")) < 0 then
  225.        Cleanexit("Sample Nr.6 konnte nicht geladen werden!",10);
  226.     If (LoadSample(7,"8svx/jump.instr")) < 0 then
  227.        Cleanexit("Sample Nr.7 konnte nicht geladen werden!",10);
  228.     If (LoadSample(8,"8svx/yay3.instr")) < 0 then
  229.        Cleanexit("Sample Nr.8 konnte nicht geladen werden!",10);
  230.  
  231.     InitVB();  { * Den VBServer initialisieren. * }
  232.     GfxBase := OpenLibrary("graphics.library",0);
  233.     IF GfxBase = NIL THEN cleanexit("Can`t open Gfx.lib.",20);
  234.  
  235. { Jetzt kommt der Screen, das Window und die Console dran }
  236.     Scr := OpenScreen(Adr(NewScr));
  237.     IF Scr = NIL THEN cleanexit("Can`t open Screen.",5);
  238.  
  239.     NewWin.Screen := Scr;
  240.     Win := OpenWindow(Adr(NewWin));
  241.     IF Win = NIL THEN cleanexit("Can`t open window.",5);
  242.  
  243.     MyRPort:=Win^.RPort;
  244.     MyVPort:=Adr(Scr^.SViewPort);
  245.     MyBitMap := MyRPort^.BitMap;
  246.  
  247.     LoadRGB4(MyVPort,ADR(Farbtabelle),8); { Die Farbtabelle kommt aus
  248.                                             Bilder.p. }
  249. { * Jetzt die Picturedaten initialisieren. * }
  250.  
  251.     ImageAstronaut.Imagedata := ChipCopy(ADR(ImageDataAstronaut),30*2);
  252.     ImageAtomium.Imagedata   := ChipCopy(ADR(ImageDataAtomium),66*2);
  253.     ImageEieruhr.Imagedata   := ChipCopy(ADR(ImageDataEieruhr),24*2);
  254.     ImageFragezeichen.Imagedata := ChipCopy(ADR(ImageDataFragezeichen),39*2);
  255.     ImageTankstelle.Imagedata := ChipCopy(ADR(ImageDataTankstelle),20*2);
  256.     ImageSchiff.Imagedata     := ChipCopy(ADR(ImageDataSchiff),48*2);
  257.     ImageFalle.Imagedata      := ChipCopy(ADR(ImageDataFalle),40*2);
  258.     ImageExplosion1.Imagedata := ChipCopy(ADR(ImageDataExplosion1),78*2);
  259.     ImageExplosion2.Imagedata := ChipCopy(ADR(ImageDataExplosion2),78*2);
  260.     ImageExplosion3.Imagedata := ChipCopy(ADR(ImageDataExplosion3),78*2);
  261.  
  262.     Picture[1] := ADR(ImageAstronaut);
  263.     Picture[2] := ADR(ImageEieruhr);
  264.     Picture[3] := ADR(ImageFragezeichen);
  265.     Picture[4] := ADR(ImageAtomium);
  266.     Picture[5] := ADR(ImageTankstelle);
  267.     Picture[6] := ADR(ImageSchiff);
  268.     Picture[7] := ADR(ImageFalle);
  269.     Picture[8] := ADR(ImageExplosion1);
  270.     Picture[9] := ADR(ImageExplosion2);
  271.     Picture[10] := ADR(ImageExplosion3);
  272.  
  273. { Und unseren Blitterspeicher. }
  274.     BlittiSpeicher := AllocRaster(80,200);
  275.     if BlittiSpeicher = Nil then cleanexit("Kein Chip-Mem für Blitterspeicher.",20);
  276.  
  277. { Ein bischen Zufall.}
  278.     SelfSeed();
  279.  
  280. end; { Init }
  281.  
  282. {/***********************************************************************/}
  283. procedure Print(xpos,ypos : short; stext : string);
  284. { Zeichnet an der Stelle ypos, xpos den Text stext. }
  285. var
  286.     tt : short;
  287. begin
  288.     Move(MyRPort,xpos,ypos);
  289.     tt := short(StrLen(stext));
  290.     GText(MyRPort, stext, tt);
  291. end; {Print}
  292.  
  293. {***********************************************************************}
  294. function GetKey(): byte;
  295. var
  296.     tt : byte;
  297. begin
  298.     tt := GetJoy2();
  299.     if tt <> 0 then begin
  300.         if (tt and 1) = 1 then GetKey := 2; { * Rechts * }
  301.         if (tt and 2) = 2 then GetKey := 1; { * Links  * }
  302.         if (tt and 4) = 4 then GetKey := 4; { * runter * }
  303.         if (tt and 8) = 8 then GetKey := 3; { * hoch   * }
  304.     end;
  305.  
  306.     { * Abfrage der Tasten, wenn es nicht der Joystick war * }
  307.  
  308.     tt := GetChar();
  309.     if tt = 97 then     {/*   <-   */ }
  310.        GetKey := 1;
  311.     if tt = 99 then     {/*   ->   */ }
  312.        GetKey := 2;
  313.     if tt = 103 then    {/*   hoch  */}
  314.        GetKey := 3;
  315.     if tt = 101 then    {/*  runter */}
  316.        GetKey := 4;
  317.     GetKey := 0;        { * War wohl alles nichts * }
  318. end;{GetKey}
  319.  
  320. { ********************************************************************* }
  321. { Auch das Highscore wollen wir laden und speichern. Und natürlich wol- }
  322. { len wir mit der Punktzahl eines Spielers auch seinen Platz ermitteln. }
  323.  
  324. procedure LoadHighscore;
  325. var
  326.     infile : file of spielerdef;
  327.     flag : boolean;
  328.     a : byte;
  329.     tt, tt1  : byte;
  330. begin
  331.     flag:=true;
  332.     flag := reopen("8svx/Ufo.Highscore",infile);
  333.     if flag = true then begin
  334.         for a := 1 to 10 do
  335.             read(infile,spieler[a]);
  336.         close(infile);
  337.     end;{if}
  338.     if flag = false then begin
  339.        for tt:=1 to 10 do begin
  340.            for tt1 := 1 to 20 do
  341.                spieler[tt].name[tt1] := ' ';
  342.            spieler[tt].name[21] := '\0';
  343.            spieler[tt].punkte := 0;
  344.            spieler[tt].lev    := 0;
  345.        end;{for}
  346.     end;{if}
  347. end;{LoadHighScore}
  348.  
  349. {***}
  350.  
  351. procedure SaveHighscore;
  352. var
  353.     outfile : file of spielerdef;
  354.     flag : boolean;
  355.     a : byte;
  356. begin
  357.     flag:=true;
  358.     flag := open("8svx/Ufo.Highscore",outfile);
  359.     if flag = true then begin
  360.         for a := 1 to 10 do
  361.             write(outfile,spieler[a]);
  362.         close(outfile);
  363.     end;{if}
  364. end;{SaveHighScore}
  365.  
  366. {***}
  367.  
  368. function Insertscore(Punkte : integer): byte;
  369. { Liefert den entsprechenden Tabellenplatz zurück und verschiebt
  370.   entsprechend die Tabelle. An dem frei werdenden Platz wird alles
  371.   auf Null gesetzt. Wenn der Tabplatz nicht gefunden werden kann
  372.   gibt es -1 zurück. }
  373.  
  374. VAR
  375.     tt, tt1 : byte;
  376.     loop    : boolean;
  377.  
  378. begin
  379.     tt := 1;
  380.     loop := true;
  381.     repeat
  382.         if Spieler[tt].punkte > Punkte then begin { Punktzahl Tab größer? }
  383.                          tt:=tt+1;         { Ja, also nächster Tab-Platz }
  384.                          if tt>10 then begin
  385.                             loop:=false; { Ende Tab ?}
  386.                             InsertScore := -1;
  387.                          end;
  388.         end;
  389.         if Spieler[tt].punkte <= Punkte then begin
  390.  
  391.     {* An der Position TT steht ein Spieler mit niedriger Punktzahl *}
  392.     {* oder gleicher Punktzahl                                      *}
  393.     {* Deshalb muß jetzt die ganze Tabelle verschoben werden.       *}
  394.  
  395.            loop := false;
  396.            for tt1 := 10 downto tt+1 do begin
  397.                strcpy(ADR(Spieler[tt1].name),ADR(Spieler[tt1-1].name));
  398.                Spieler[tt1].punkte:=Spieler[tt1-1].punkte;
  399.                Spieler[tt1].lev   :=Spieler[tt1-1].lev;
  400.            end;
  401.            strcpy(ADR(Spieler[tt].name),"                    ");
  402.            Spieler[tt].punkte := 0;
  403.            Spieler[tt].lev    := 0;
  404.            InsertScore := tt;
  405.         end;
  406.     until loop = false;
  407. end; {Insertscore}
  408.  
  409. {***********************************************************************}
  410. Procedure ShowHighscore();
  411. { * Zeigt Alle High-Scores an. * }
  412. var
  413.     tt, tt1 : integer;
  414.     tt2 : string;
  415.  
  416. begin
  417.     LoadHighscore();
  418.     tt2 := AllocString(10);
  419.     SetRast(MyRPort,0);
  420.     SetColour(0,1);
  421.     for tt := 1 to 10 do begin
  422.         Print(20,tt*10,"  .:                      -  Punkte:        -  Level:        ");
  423.         tt1 :=IntToStr(tt2,tt);
  424.         Print(20,tt*10,tt2);
  425.         Print(60,tt*10,ADR(Spieler[tt].name));
  426.         tt1 :=IntToStr(tt2,Spieler[tt].punkte);
  427.         Print(316,tt*10,tt2);
  428.         tt1 :=IntToStr(tt2,Spieler[tt].lev);
  429.         Print(452,tt*10,tt2);
  430.     end;
  431.     FreeString(tt2);
  432.     repeat
  433.         tt := GetKey();
  434.     until tt <> 0;
  435. end; { ShowHighscore }
  436.  
  437. {***********************************************************************}
  438. procedure PrintScore();
  439. { * Schreibt die Punktzahl auf den Bildschirm. * }
  440. var
  441.     tt1 : string;
  442. begin
  443.     tt1 := AllocString(10);
  444.     SetColour(1,0);
  445.     Move(MyRPort,240,7);
  446.     GText(MyRPort,"Points: ", 8);
  447.     IntToStr6(tt1,irspunkte);
  448.     GText(MyRport,tt1,6);
  449.     FreeString(tt1);
  450. end; { *  Printscore * }
  451.  
  452. {***********************************************************************}
  453. procedure PrintTank();
  454. { * Bringt den Tankinhalt auf den Bildschirm. * }
  455. var
  456.     tt1 : short;
  457. begin
  458. { * Erstmal löschen * }
  459.     SetColour(0,0);
  460.     Rectfill(MyRPort,128,1,228,9);
  461.  
  462.     SetColour(1,0);
  463.     Move(MyRPort,80,7);
  464.     GText(MyRPort,"Fuel: ", 6);
  465.     if irstank < 16 then
  466.         SetColour(3,3);   { Rote Farbe  }
  467.     if irstank > 15 then
  468.         SetColour(7,7);   { Grüne Farbe }
  469.     tt1 := irstank;
  470.     if tt1 > 100 then tt1 := 100;
  471.     tt1 := tt1 + 128;
  472.     Rectfill(MyRPort,128,1,tt1,9);
  473. end; { * PrintTank * }
  474.  
  475. {***********************************************************************}
  476. Procedure InitObjekts(Wieviele : byte);
  477. { * Initialisiert die Objekte und zeichnet sie auf den Schirm. Die
  478.     Objekte sind wie folgt aufgeteilt:  1 -> Ist das Raumschiff,
  479.                                         100 - 199 -> die Zeichen,
  480.                                         200 - 255 -> die Fallen. * }
  481. var
  482.     tt, tt1  : short;
  483. begin
  484.     { Erstmal alle als nicht belegt kennzeichnen. }
  485.     for tt := 0 to 255 do
  486.         Objekt[tt].Ox := -1;
  487.  
  488.     { Die Begrenzungslinien }
  489.     SetColour(4,0);
  490.  
  491.     { Oben }
  492.     Move(MyRPort, 0 ,  10);
  493.     Draw(MyRPort, 639, 10);
  494.  
  495.     { rechts }
  496.     Draw(MyRPort, 639, 189);
  497.  
  498.     { links }
  499.     Move(MyRPort, 0,  10);
  500.     Draw(MyRPort, 0, 189);
  501.  
  502.     { unten }
  503.     Draw(MyRPort, 639, 189);
  504.  
  505.     { * Und die entsprechenden Objektdefinitionen *  }
  506.  
  507.     { Oben }
  508.     with Objekt[2] do begin
  509.          Ox := 0; Oy := 10; Sizex := 639; Sizey := 0;
  510.     end;
  511.  
  512.     { rechts }
  513.     with Objekt[3] do begin
  514.          Ox := 639; Oy := 10; Sizex := 0; Sizey := 179;
  515.     end;
  516.  
  517.     { links }
  518.     with Objekt[4] do begin
  519.          Ox := 0; Oy := 10; Sizex := 0; Sizey := 179;
  520.     end;
  521.  
  522.     { unten }
  523.     with Objekt[5] do begin
  524.          Ox := 0; Oy := 189; Sizex := 639; Sizey := 0;
  525.     end;
  526.  
  527.  
  528.     { Und jetzt das Raumschiff. }
  529.     with Objekt[1] do begin
  530.          Ox := 2; Oy := 100;
  531.          Sizex := Picture[6]^.width;
  532.          Sizey := Picture[6]^.height;
  533.          Speedx := 0;  { Raumschiff hat keine Fahrt! }
  534.          Speedy := 0;  { Raumschiff hat keine Fahrt! }
  535.          typ := 6;
  536.     end;
  537.  
  538.     { Die Objekte }
  539.  
  540.     for tt := 101 to 100+wieviele do begin
  541.         repeat
  542.             with Objekt[tt] do begin
  543.                  typ := RangeRandom(4)+1; { * 1 - 5 * }
  544.                  Ox := 1  + Rangerandom(638 - Picture[Objekt[tt].typ]^.width);
  545.                  Oy := 11 + Rangerandom(178 - Picture[Objekt[tt].typ]^.height);
  546.                  Sizex := Picture[Objekt[tt].typ]^.width;
  547.                  Sizey := Picture[Objekt[tt].typ]^.height;
  548.             end;
  549.  
  550.              { * Gibts an der Position schon ein Objekt? * }
  551.              tt1 := CollObjekt(1, 100+wieviele, Objekt[tt].Ox,
  552.                                Objekt[tt].Oy, Objekt[tt].Sizex,
  553.                                Objekt[tt].Sizey);
  554.              if tt1 = tt then begin   { * Selbst gefunden. * }
  555.                 if tt <> 100+wieviele then
  556.                    tt1 := CollObjekt(tt1+1, 101+wieviele, Objekt[tt].Ox,
  557.                                      Objekt[tt].Oy, Objekt[tt].Sizex,
  558.                                      Objekt[tt].Sizey);
  559.                 if tt = 100+wieviele then tt1 := -1;
  560.              end;
  561.         until tt1 = -1;
  562.     end;
  563.  
  564.     { * Und alles zeichnen * }
  565.  
  566.     DrawObjekt(101,100+wieviele);
  567.  
  568. end; { InitObjekt }
  569.  
  570. {***********************************************************************}
  571. Procedure InitFallen(wieviele : byte);
  572. { * Initialisiert die Fallen und zeichnet sie auf den Schirm. * }
  573. var
  574.     tt, tt1  : short;
  575. begin
  576.     { * Die Fallen. *  }
  577.  
  578.     for tt := 201 to 200+wieviele do begin
  579.         repeat
  580.             with Objekt[tt] do begin
  581.                  typ := 7;   { * Immer eine Falle. * }
  582.                  Ox := 21  + Rangerandom(618 - Picture[Objekt[tt].typ]^.width);
  583.                  Oy := 11 + Rangerandom(178 - Picture[Objekt[tt].typ]^.height);
  584.                  Sizex  := Picture[7]^.width;
  585.                  Sizey  := Picture[7]^.height;
  586.             end;
  587.              if Level < 10 then begin
  588.                 with Objekt[tt] do begin
  589.                      Speedx := RangeRandom(Levels[Level].Fallenspeed);
  590.                      Speedy := RangeRandom(Levels[Level].Fallenspeed);
  591.                 end;
  592.              end;
  593.              if Level > 9 then begin
  594.                 with Objekt[tt] do begin
  595.                      Speedx := RangeRandom(Levels[10].Fallenspeed);
  596.                      Speedy := RangeRandom(Levels[10].Fallenspeed);
  597.                 end;
  598.              end;
  599.  
  600.              { * Gibts an der Position schon ein Objekt? * }
  601.              tt1 := CollObjekt(1, 255, Objekt[tt].Ox,
  602.                                Objekt[tt].Oy, Objekt[tt].Sizex,
  603.                                Objekt[tt].Sizey);
  604.              if tt1 = tt then begin   { * Selbst gefunden. * }
  605.                 if tt <> 200+wieviele then
  606.                    tt1 := CollObjekt(tt1+1, 200+wieviele, Objekt[tt].Ox,
  607.                                      Objekt[tt].Oy, Objekt[tt].Sizex,
  608.                                      Objekt[tt].Sizey);
  609.                 if tt = 200+wieviele then tt1 := -1;
  610.              end;
  611.         until tt1 = -1;
  612.     end;
  613.  
  614.     { * Und alles zeichnen * }
  615.  
  616.     DrawObjekt(201,200+wieviele);
  617.  
  618. end; { InitFallen }
  619.  
  620. {***********************************************************************}
  621. { Selbstredend. }
  622. procedure Anleitung;
  623. var
  624.     tt : byte;
  625. begin
  626.     SetRast(MyRPort,0);
  627.     SetColour(1,0);
  628.     Print(20,10,"Das Ziel des Spieles ist es, möglichst lange über den Bildschirm zu fliegen");
  629.     Print(20,18,"Der Joystick oder die Cursor-Tasten helfen dir bei der Steurerung. Aber    ");
  630.     Print(20,26,"denke daran: jede Joystick- oder Cursortastenbewegung kostet dich eine     ");
  631.     Print(20,34,"Treibstoffeinheit. Von den Wänden wirst du zurückgeschleudert.             ");
  632.     Print(20,42,"Um Treibstoff zu sparen lasse dich am besten treiben.                      ");
  633.     DrawImage(MyRport,Picture[1],10,45);
  634.     Print(40,54," ---> 1 Punkt          ");
  635.     DrawImage(MyRport,Picture[2],10,70);
  636.     Print(40,78," ---> 3 Punkte         ");
  637.     DrawImage(MyRport,Picture[3],10,100);
  638.     Print(40,110," ---> 1 - 10 Punkte   ");
  639.     DrawImage(MyRport,Picture[4],10,160);
  640.     Print(40,168," ---> 5 Punkte        ");
  641.     DrawImage(MyRport,Picture[5],10,130);
  642.     Print(40,139," ---> 10 Tankeinheiten");
  643.     DrawImage(MyRport,Picture[7],250,45);
  644.     Print(280,54," ---> Der Tod !");
  645.     Print(40,190,"Viel Spaß !!! (Bitte <Taste> oder Joystick)");
  646.     repeat
  647.         tt := GetKey();
  648.         WaitVB(2);
  649.     until tt <> 0;
  650.     SetRast(MyRPort,0);
  651. end;{Anleitung}
  652.  
  653. {***********************************************************************}
  654. { * TitleScreen * }
  655. Procedure Titlescreen();
  656. { * Bringt den Schriftzug auf den Schirm und fragt die Tasten nach
  657.   weiteren Aktionen ab. Und noch ein bischen Augenwischerei. * }
  658. const
  659.         Titelpunkte : array[1..32] of short =
  660. (      150, 50, 150,100,200,100,200, 50,    { U }
  661.        250, 50, 300, 50,250, 50,250, 75,
  662.        300, 75, 250, 75,250,100,            { F }
  663.        350, 50, 400, 50,400,100,350,100,
  664.        350, 50                              { O }
  665. );
  666.  
  667. var
  668.     tt, tt4  : short; { * Für ein bischen Augenwischerei. * }
  669. begin
  670.     repeat
  671.         tt  := 230;
  672.         tt4 := -5;
  673.         SetRast(MyRPort,0);
  674.         Move(MyRPort,150,50);
  675.         SetColour(1,0);
  676.         PolyDraw(MyRPort,4,ADR(Titelpunkte[1]));
  677.         Move(MyRPort,250,50);
  678.         SetColour(2,0);
  679.         PolyDraw(MyRPort,7,ADR(Titelpunkte[9]));
  680.         Move(MyRPort,350,50);
  681.         SetColour(6,0);
  682.         PolyDraw(MyRPort,5,ADR(Titelpunkte[23]));
  683.  
  684.         SetColour(1,0);
  685.         Print(40,130,"Version 2.2  (c) 1982, 92, 93 by Jörg Wach ");
  686.         Print(40,140,"Dieses Spiel ist Giftware! Wenn es Dir gefällt, dann schreib es mir.");
  687.         Print(140,170,"<Hoch>    = Anleitung, <Runter> = Spiel");
  688.         Print(140,190,"<Links>   = Highscore, <Rechts> = Ende ");
  689.         repeat
  690.             WaitVB(2);
  691.             key:=GetKey();      { * Was darfs sein, Fremder? * }
  692.             tt := tt + tt4;
  693.             if tt  > 350 then tt4 := -tt4;  { * und Rückwärts. * }
  694.             if tt  < 0   then tt4 := -tt4;  { * Genauso. * }
  695.             ScrollRaster(MyRPort,tt4, 0, 5, 45,635,105); { * Wisch, wisch ... * }
  696.         until key <> 0;
  697.  
  698.         if key = 1 then begin   { * Highscore kommt und geht ... * }
  699.            ShowHighscore();
  700.            SetRast(MyRPort,0);
  701.         end;
  702.  
  703.         if key = 2 then     { * Ab gehts ..... * }
  704.            CleanExit("Bye Bye ...",0); { * Sauberer Abgang! * }
  705.         if key = 3 then begin     { * Hoch gehts her ... * }
  706.            Anleitung();
  707.            SetRast(MyRPort,0);
  708.         end;
  709.     until key = 4;
  710. end;
  711.  
  712. {***********************************************************************}
  713. { Level }
  714. procedure SetLevel();
  715. { * Setzt alle erforderlichen Variablen und zeigt den Level an,
  716.     in welchem man (Frau?) sich befindet. * }
  717. var
  718.     tt  : string;
  719.     tt1 : byte;
  720. begin
  721.     Inc(Level);     { * Um eins erhöhen. * }
  722.     tt1 := Level;
  723.     if tt1 > 10 then tt1 := 10; { * Und kürzen, wenns sein muß. * }
  724.     tt := AllocString(10);
  725.     SetRast(MyRPort,0);
  726.     SetColour(1,1);
  727.     Rectfill(MyRPort,270,80,370,120);
  728.     SetColour(0,1);
  729.     Print(271,107,"Level ");
  730.     IntToStr6(tt, level);
  731.     GText(MyRPort, tt, 6);  { * Cursor steht richtig, also schreiben wir. * }
  732.  
  733.     FreeString(tt);
  734.     SetColour(0,2);
  735.     Print(219,132," ");
  736.     Print(227,132,Levels[tt1].Anmerkung);
  737.     GText(MyRPort, " ", 1);  { * Cursor steht richtig, also schreiben wir. * }
  738.  
  739.     repeat
  740.         PlaySample(1);
  741.         for tt1 := 1 to 7 do begin
  742.             SetColour(tt1,0);
  743.             Print(219,140," Bitte eine Taste Drücken! ");
  744.         end;
  745.         key:=GetKey();      { * Wir warten. * }
  746.         WaitVB(2);
  747.     until key <> 0;
  748.     SetRast(MyRPort,0);
  749.  
  750.     tt1 := Level;
  751.     if tt1 > 10 then tt1 := 10; { * Und kürzen, wenns sein muß. * }
  752.  
  753.     { * Und jetzt initialisieren wir den anderen Kram. * }
  754.  
  755.     InitObjekts(Levels[tt1].Objekte);
  756.  
  757.     { * Auch die Fallen wollen leben. * }
  758.  
  759.     if Levels[tt1].Fallen > 0 then InitFallen(Levels[tt1].Fallen);
  760.  
  761.     { * Und natürlich müssen wir unseren Zähler akzualisieren. * }
  762.  
  763.     MaxObjekts := Levels[tt1].Objekte;
  764. end;
  765.  
  766. {***********************************************************************}
  767. { * Animation der restlichen Objekte, sprich Fallen und Explosionen. *}
  768. { * Dieses sind : 100 - 199 -> die Zeichen, 200 - 255 -> die Fallen. * }
  769.  
  770. Procedure AniObjekts();
  771. var
  772.     tt, tt1, tt2, tt4 : short;
  773. begin
  774.     for tt := 101 to 199 do begin
  775.         if Objekt[tt].typ > 7 then begin { * Explosionen * }
  776.            if Objekt[tt].Ox <> -1 then begin   { * Keine Toten. *}
  777.               Objekt[tt].Phase1 := Objekt[tt].Phase1 - 1;
  778.               if Objekt[tt].Phase1 < 1 then begin  { * Neue Explosion. * }
  779.                  UndrawObjekt(tt,tt);              { * Löschen. * }
  780.                  Objekt[tt].typ := Objekt[tt].typ + 1;
  781.  
  782.                  if Objekt[tt].typ > 10 then
  783.                     Objekt[tt].Ox := -1;     { * Ist also Tot * }
  784.  
  785.                  if Objekt[tt].typ < 11 then begin
  786.                     Objekt[tt].Phase1 := 5; { * Neu beginnen. * }
  787.                     DrawObjekt(tt,tt);      { * Und neue Explosion. * }
  788.                  end;
  789.               end; { * wir brauchen nichts zu zeichnen. * }
  790.            end; { * Tote Objekte. * }
  791.         end; { * Keine Explosionen. * }
  792.     end; { For - Schleife. * }
  793.  
  794. { * Wenns eine Falle ist dann Positionsabfrage auf neue Position. * }
  795.     for tt := 201 to 255 do begin
  796.         if Objekt[tt].Ox <> -1 then begin
  797.            UndrawObjekt(tt,tt);              { * Löschen. * }
  798.            { * Ecken wir irgendwo an ? * }
  799.            if (Objekt[tt].Ox + Objekt[tt].Speedx) < 1 then begin
  800.                PlaySample(7);
  801.                Objekt[tt].Speedx := -Objekt[tt].Speedx;
  802.            end;
  803.            if (Objekt[tt].Ox + Objekt[tt].Speedx) > 618 then begin
  804.                PlaySample(7);
  805.                Objekt[tt].Speedx := -Objekt[tt].Speedx;
  806.            end;
  807.  
  808.            if (Objekt[tt].Oy + Objekt[tt].Speedy) < 11 then begin
  809.                PlaySample(7);
  810.                Objekt[tt].Speedy := -Objekt[tt].Speedy;
  811.            end;
  812.            if (Objekt[tt].Oy + Objekt[tt].Speedy) > 178 then begin
  813.                PlaySample(7);
  814.                Objekt[tt].Speedy := -Objekt[tt].Speedy;
  815.            end;
  816.  
  817.            { * Neue Position ermitteln. * }
  818.            Objekt[tt].Ox := Objekt[tt].Ox + Objekt[tt].Speedx;
  819.            Objekt[tt].Oy := Objekt[tt].Oy + Objekt[tt].Speedy;
  820.  
  821.            { * Ist da irgendwas im Weg ? * }
  822.            { * Als erstes das Raumschiff. * }
  823.  
  824.            tt4 := CollObjekt(1,1, Objekt[tt].Ox, Objekt[tt].Oy,
  825.                              Objekt[tt].sizex, Objekt[tt].sizey);
  826.            if tt4 = 1 then begin { * Raumschiff! * }
  827.               loop := False;
  828.               PlaySample(4);
  829.               WaitVB(10);
  830.               return;    { * Sofort raus hier. * }
  831.            end;
  832.  
  833.            GraphCollision(Objekt[tt].Ox,Objekt[tt].Oy,Objekt[tt].sizex,Objekt[tt].sizey);
  834.         if blitctrl = 1 then begin
  835.            { * Jetzt die anderen Objekte. * }
  836.            tt1 := 101;
  837.            tt2 := 255;
  838.            tt4 := 0;
  839.  
  840.            repeat
  841.                 tt4 := CollObjekt(tt1,tt2, Objekt[tt].Ox, Objekt[tt].Oy,
  842.                                   Objekt[tt].sizex, Objekt[tt].sizey);
  843.  
  844. { * Wenn da was ist, dann das Objekt löschen und die Daten für die
  845.     Explosion initieren. * }
  846.  
  847.                 if tt4 <> -1 then begin
  848.  
  849.                    if Objekt[tt4].typ > 6 then begin
  850.                       tt1 := tt4+1;
  851.                    end;
  852.  
  853.                    if Objekt[tt4].typ < 7 then begin
  854.                       PlaySample(5);
  855.                       dec(MaxObjekts);  { * Wieder eins weniger. * }
  856.                       UnDrawObjekt(tt4,tt4); { * Wech * }
  857.                       Objekt[tt4].Typ := 8;  { * Explosion1 * }
  858.                       Objekt[tt4].Phase1 := 5;  { * 5 mal auftauchen * }
  859.                       Objekt[tt4].sizex := Picture[8]^.width;
  860.                       Objekt[tt4].sizey := Picture[8]^.height;
  861.                       DrawObjekt(tt4,tt4); { * Und wieder zeichnen * }
  862.                    end;
  863.                    if tt1 > 255 then tt4 := -1;
  864.                 end; { if }
  865.            until tt4 = -1;
  866.          end;
  867.            DrawObjekt(tt,tt);              { * Falle zeichnen. * }
  868.         end; { * Also auch kein Lebendes Objekt. * }
  869.     end; { * For * }
  870. end; { * AniObjekts * }
  871.  
  872. {/***********************************************************************/
  873. /*******  Hauptprogramm  (MAIN)                                    *****/
  874. /***********************************************************************/}
  875.  
  876. var
  877.     i, itt : integer;
  878.  
  879.     tempstr : string;
  880.  
  881.     temp1,
  882.     temp2,
  883.     temp3,
  884.     temp4,
  885.     temp5       : short;  { Temporäre Zwischenspeicher. }
  886.  
  887. begin
  888.     tempstr := AllocString(80);
  889.     init();
  890.     mainflag := true;
  891.  
  892. while mainflag = true do begin
  893.     Titlescreen();
  894.     Level := 0; { * Muß 0 sein, da er von SetLevel erhöht wird. * }
  895.     SetLevel(); { * Initialisieren wir mal alles. * }
  896.     SetTime();
  897.     loop:=true;
  898.     irstank:=20;
  899.     irspunkte:=0;
  900.  
  901.     { * Spieldaten schreiben * }
  902.     PrintScore();
  903.     PrintTank();
  904.  
  905.     while loop = true do begin
  906.         { * Alte Position sichern * }
  907.         UnDrawObjekt(1,1);  { * Raumschiff löschen. * }
  908.  
  909.         key:=GetKey();      { Wohin geht die Reise? }
  910.         if key <> 0 then begin
  911.            irstank := irstank - 1;
  912.            PrintTank();
  913.            if key = 3 then
  914.               Objekt[1].Speedy := Objekt[1].Speedy - 1; { * Hoch * }
  915.  
  916.            if key = 4 then
  917.               Objekt[1].Speedy := Objekt[1].Speedy + 1; { * runter * }
  918.  
  919.            if key = 1 then
  920.               Objekt[1].Speedx := Objekt[1].Speedx - 1; { * links * }
  921.  
  922.            if key = 2 then
  923.               Objekt[1].Speedx := Objekt[1].Speedx + 1; { * rechts * }
  924.         end;
  925.  
  926.         { * Abbruch ? * }
  927.         if GetChar() = $73 then     { * DEL-Taste gedrückt! * }
  928.             CleanExit("Kontrollierter Abbruch !",0);
  929.  
  930.         key := 0;
  931.  
  932.         { * Jetzt kommt die Positionsüberprüfung. * }
  933.  
  934.         if (Objekt[1].Ox + Objekt[1].Speedx) < 1 then begin
  935.            PlaySample(3);
  936.            Objekt[1].Speedx := -Objekt[1].Speedx;
  937.         end;
  938.         if (Objekt[1].Ox + Objekt[1].Speedx) > 618 then begin
  939.            PlaySample(3);
  940.            Objekt[1].Speedx := -Objekt[1].Speedx;
  941.         end;
  942.  
  943.         if (Objekt[1].Oy + Objekt[1].Speedy) < 11 then begin
  944.            PlaySample(3);
  945.            Objekt[1].Speedy := -Objekt[1].Speedy;
  946.         end;
  947.         if (Objekt[1].Oy + Objekt[1].Speedy) > 178 then begin
  948.            PlaySample(3);
  949.            Objekt[1].Speedy := -Objekt[1].Speedy;
  950.         end;
  951.  
  952.         Objekt[1].Ox := Objekt[1].Ox + Objekt[1].Speedx;
  953.         Objekt[1].Oy := Objekt[1].Oy + Objekt[1].Speedy;
  954.  
  955.         { * Ist da irgendwas im Weg ? * }
  956.  
  957.         GraphCollision(Objekt[1].Ox,Objekt[1].Oy,Objekt[1].sizex,Objekt[1].sizey);
  958.      if blitctrl = 1 then begin
  959.  
  960.         temp1 := 101;
  961.         temp4 := 0;
  962.         temp5 := 255;
  963.         repeat  { * Abfrage, ob mehrere Objekte an der Stelle stehen * }
  964.                temp4 := CollObjekt(temp1,temp5, Objekt[1].Ox, Objekt[1].Oy,
  965.                                    Objekt[1].sizex, Objekt[1].sizey);
  966.                if temp4 <> -1 then begin
  967.                  if Objekt[temp4].typ < 8 then begin
  968.                   PlaySample(2);
  969.                   if Objekt[temp4].typ = 1 then begin
  970.                      irspunkte:=irspunkte + 1;
  971.                      UnDrawObjekt(temp4,temp4); { * Wech * }
  972.                      Objekt[temp4].Ox := -1;   { * Als Tot kennzeichnen. * }
  973.                   end;
  974.  
  975.                   if Objekt[temp4].typ = 2 then begin
  976.                      irspunkte:=irspunkte + 3;
  977.                      UnDrawObjekt(temp4,temp4); { * Wech * }
  978.                      Objekt[temp4].Ox := -1;   { * Als Tot kennzeichnen. * }
  979.                   end;
  980.  
  981.                   if Objekt[temp4].typ = 3 then begin
  982.                      irspunkte:=irspunkte + RangeRandom(9) + 1;
  983.                      UnDrawObjekt(temp4,temp4); { * Wech * }
  984.                      Objekt[temp4].Ox := -1;   { * Als Tot kennzeichnen. * }
  985.                   end;
  986.  
  987.                   if Objekt[temp4].typ = 4 then begin
  988.                      irspunkte:=irspunkte + 5;
  989.                      UnDrawObjekt(temp4,temp4); { * Wech * }
  990.                      Objekt[temp4].Ox := -1;   { * Als Tot kennzeichnen. * }
  991.                   end;
  992.  
  993.                   if Objekt[temp4].typ = 5 then begin
  994.                      irstank := irstank + 10;
  995.                      PrintTank();
  996.                      UnDrawObjekt(temp4,temp4); { * Wech * }
  997.                      Objekt[temp4].Ox := -1;   { * Als Tot kennzeichnen. * }
  998.                   end;
  999.  
  1000.                   if Objekt[temp4].typ = 7 then begin
  1001.                      PlaySample(4);
  1002.                      Loop  := false; { * Falle * }
  1003.                      temp4 := -1; { * Sonst kommen wir nicht mehr raus! * }
  1004.                   end;
  1005.  
  1006.                   dec(MaxObjekts);  { * Wieder eins weniger. * }
  1007.                  end; { * if * }
  1008.                  temp1 := temp4 + 1;
  1009.                end; { if }
  1010.         until temp4 = -1;
  1011.         PrintScore();
  1012.      end;
  1013.         { * Jetzt das Raumschiff zeichnen * }
  1014.  
  1015.         DrawObjekt(1,1);
  1016.  
  1017.         { * Und jetzt animieren wir die restlichen Objekte. * }
  1018.  
  1019.         AniObjekts();
  1020.  
  1021.         { * Tank leer? * }
  1022.  
  1023.         if irstank<1 then loop:=false; { * Oh ja, also Ende. * }
  1024.  
  1025.         { * Noch Objekte da ? * }
  1026.  
  1027.         if MaxObjekts < 1 then begin { * Neue Runde! * }
  1028.  
  1029.            PlaySample(8);
  1030.            WaitVB(10);
  1031.            SetLevel();        { * Zeig dich! * }
  1032.            SetTime();
  1033.  
  1034.            { * Spieldaten schreiben * }
  1035.            PrintScore();
  1036.            PrintTank();
  1037.  
  1038.         end;
  1039.  
  1040.         { * Und auf den VBServer warten. * }
  1041.  
  1042.         If Level<11 then WaitVB(Levels[Level].Spielspeed);
  1043.  
  1044.         If Level>10 then WaitVB(Levels[10].Spielspeed);
  1045.  
  1046.     end;{loop}
  1047.  
  1048.     { * Tja, jedes Spiel geht einmal zu Ende. * }
  1049.  
  1050.     PlaySample(4);
  1051.     WaitVB(10);
  1052.  
  1053.     SetRast(MyRPort,0);
  1054.     i := IntToStr(tempstr,irspunkte);
  1055.     Print(10,10,"Punkte: ");
  1056.     Print(74,10,tempstr);
  1057.  
  1058.     LoadHighscore();
  1059.     itt := InsertScore(irspunkte);
  1060.     if (itt > 0) and (itt < 11)  then begin
  1061.           SetColour(1,0);
  1062.           Print(2,10,"Du hast den  . Platz mit        Punkten erreicht.");
  1063.           i := IntToStr(tempstr,itt);
  1064.           SetColour(5,0);
  1065.           Print(98,10,tempstr);
  1066.           IntToStr6(tempstr,irspunkte);
  1067.           Print(202,10,tempstr);
  1068.           SetColour(1,0);
  1069.           Print(40,40,"Bitte gebe deinen Namen ein: ");
  1070.           GetString(40, 50, 20, ADR(Spieler[itt].name));
  1071.           Spieler[itt].punkte:=irspunkte;
  1072.           Spieler[itt].lev   :=Level;
  1073.     end;{if}
  1074.     SaveHighscore();
  1075. end;
  1076.  
  1077.     FreeString(tempstr);
  1078.     CleanExit(Nil,0);   { * Und ein sauberer Abgang! * }
  1079. end.
  1080.  
  1081.